---
title: "Fear Videos Pilot"
author: "Deshawn Sambrano"
date: "`r format(Sys.time(), '%B %d, %Y')`"
output: 
  html_document:
    toc: yes
    self_contained: yes
---

<style type="text/css">
.table {

    width: 70%;
    margin: auto;

}
</style>

```{r setup, include=FALSE}
require(reshape2)
require(Hmisc)
require(psych)
require(ggplot2)
require(ggpubr)
require(cowplot)
require(gridExtra)
require(grid)
require(ggExtra)
require(ggsci)
require(latex2exp)
require(RColorBrewer)
require(knitr)
knitr::opts_chunk$set(echo = FALSE, fig.align="center")
knitr::opts_chunk$set(cache=FALSE)
# knitr::opts_chunk$set(out.width = 1)
options(width = 110)

# Creating theme for APA in ggplot
apatheme <- theme(panel.grid.major=element_blank(),
                  panel.grid.minor=element_blank(),
                  panel.border=element_blank(),
                  panel.background = element_rect(fill = "transparent"),#
                  axis.line=element_line(),
                  text=element_text(family='sans'),#
                  plot.title = element_text(hjust = 0.5),
                  plot.subtitle = element_text(hjust = 0.5),
                  legend.key = element_rect(fill = "transparent", colour = "transparent", size = 0.25),
                  legend.box.background = element_rect(fill = "transparent", linetype="solid"),#
                  plot.background = element_rect(fill = "transparent",colour = NA))#

```

## Reading in Qualtics Data

```{r qualtrics_read}
data_dir = "../01_Data/qualtrics/pilot/raw"
clean_data_dir = "../01_Data/qualtrics/pilot/clean/"
plots_dir = "../03_Plots/pilot-plots/"
f_name <- list.files(path = data_dir, pattern = "*csv")
x <- read.csv(list.files(path = data_dir, pattern = "*csv", full.names = TRUE))

# Remove info from Qualtrics
x <- x[-c(1,2),]
# x <- x[order(x$ID),]

# Save file
new_fname <- paste0(substring(f_name,1,nchar(f_name)-4),'_CLEAN',
                    substring(f_name,nchar(f_name)-3,nchar(f_name)))
write.csv(x, paste0(clean_data_dir, new_fname), row.names = FALSE)

# Read it in again so the numerics are read in now unlike previous time
qual_data <- read.csv(paste0(clean_data_dir, new_fname))

# Remove those that didn't finish and save again
qual_data <- qual_data[qual_data$Progress == 100,] 
write.csv(qual_data, paste0(clean_data_dir, new_fname), row.names = FALSE)


# Recoding the randomization of the music
temp <- unlist(gregexpr(pattern ='\\|',as.character(qual_data$FL_8_DO)))
qual_data$M1_name <- substr(qual_data$FL_8_DO,1,temp-1)
qual_data$M2_name <- substr(qual_data$FL_8_DO,temp+1,nchar(as.character(qual_data$FL_8_DO)))
default_music_order <- paste0('M',1:4,'-',c('Stalker','Hutch','Trees','Piggy'))
M_order <- matrix(NA,length(qual_data$M1_name),2)

# Recoding the randomization of the videos
temp <- unlist(gregexpr(pattern ='\\|',as.character(qual_data$FL_13_DO)))
qual_data$V1_name <- substr(qual_data$FL_13_DO,1,temp-1)
qual_data$V2_name <- substr(qual_data$FL_13_DO,temp+1,nchar(as.character(qual_data$FL_13_DO)))
default_video_order <- paste0('V',1:3,'-',c('Face','Hear','Hills'))
V_order <- matrix(NA,length(qual_data$V1_name),2)

# Numeric form of the actual order
for (i in 1:nrow(V_order)){
    V_order[i,1] <- which(default_video_order %in% qual_data$V1_name[i])
    V_order[i,2] <- which(default_video_order %in% qual_data$V2_name[i])
    M_order[i,1] <- which(default_music_order %in% qual_data$M1_name[i])
    M_order[i,2] <- which(default_music_order %in% qual_data$M2_name[i])
}

# Using Numeric form to obtain emotion rating for Fear only and get compar vector with 1 and 0
M_order_data <- matrix(NA,length(qual_data$M1_name),2)
V_order_data <- matrix(NA,length(qual_data$M1_name),2)
M_compare_data <- matrix(NA,length(qual_data$M1_name),2)
V_compare_data <- matrix(NA,length(qual_data$M1_name),2)
for (i in 1:nrow(V_order)){
    eval(parse(text=paste0('m<-c(qual_data$M',M_order[i,1],'.Emotions_3[',i,'],',
                       'qual_data$M',M_order[i,2],'.Emotions_3[',i,'])')))
    M_order_data[i,] <- m
    if (qual_data$M.Compare[i] == 'The First Option'){
        M_compare_data[i,] <- c(1,0)
    }else{
        M_compare_data[i,] <- c(0,1)
    }
    eval(parse(text=paste0('v<-c(qual_data$V',V_order[i,1],'.Emotions_3[',i,'],',
                       'qual_data$V',V_order[i,2],'.Emotions_3[',i,'])')))
    V_order_data[i,] <- v
    if (qual_data$V.Compare[i] == 'The First Option'){
        V_compare_data[i,] <- c(1,0)
    }else{
        V_compare_data[i,] <- c(0,1)
    }
}


# Music
## Residuals
fit_1m <- lm(M_order_data[,1] ~ qual_data$Pre.Emotions_3)
fit_2m <- lm(M_order_data[,2] ~ qual_data$Pre.Emotions_3)
M_residuals <- cbind(residuals(fit_1m),residuals(fit_1m))

# Change
M_change <- M_order_data - qual_data$Pre.Emotions_3

# Video
## Residuals
fit_1v <- lm(V_order_data[,1] ~ qual_data$Pre.Emotions_3)
fit_2v <- lm(V_order_data[,2] ~ qual_data$Pre.Emotions_3)
V_residuals <- cbind(residuals(fit_1v),residuals(fit_1v))

# Change
V_change <- V_order_data - qual_data$Pre.Emotions_3

# temp <- paste0('000', rep(1:50,4))
# temp <- factor(substring(temp,nchar(temp)-2,nchar(temp)),
#                        levels=substring(temp,nchar(temp)-2,nchar(temp)),
#                        labels=substring(temp,nchar(temp)-2,nchar(temp)))

long_format <- data.frame(ID=rep(1:50,4),
                          Rating=c(M_order_data,V_order_data),
                          R_change=c(M_change,V_change),
                          Votes=c(M_compare_data,V_compare_data),
                          Type=rep(c('Music','Video'),each=length(M_order)),
                          Type_Order=rep(c(rep(1,nrow(M_order)),rep(2,nrow(M_order))),2),
                          Overall_Order=rep(1:4,each=nrow(M_order)),
                          Name=c(substr(default_music_order[M_order],4,8),
                                 substr(default_video_order[V_order],4,7))
                          )
music <- subset(long_format,long_format$Type=='Music'); music$Name <- factor(music$Name)
video <- subset(long_format,long_format$Type=='Video'); video$Name <- factor(video$Name)
m_descriptives <- describeBy(music$Rating,group = music$Name, mat = TRUE)
v_descriptives <- describeBy(video$Rating,group = video$Name, mat = TRUE)
```


## Emotion Rating and Number of Votes by Stimuli
For this study, people rating their emotions (0 to 100) for the six basic emotions. Following that, they listened to two musical pieces, which were randomly assigned of a possible four peices. After each musical piece, the again rated their emotions on the scale. After they heard both pieces, they were asked to indicate which one they thought made them more scared. Following the music, they perfomed they same task for two of the three videos. The following is a breakdown of how many people heard/saw each type.

```{r, results='axis'}
kable(table(music$Name), col.names = c('Name', 'Frequency'), caption = 'Music Frequency Table')
kable(table(video$Name), col.names = c('Name', 'Frequency'), caption = 'Video Frequency Table')
```

### Music Results
For the graphs below, the y-axis shows the differences in emotion rating between the pre- and the post- music emotion rating (for fear only), which is why some data points are negative. The first graph will plot the difference in emotion ratings by the music followed by the proportion of times the song was voted to be the scariest option. 

```{r manipulation_check_music, warning=FALSE, message=FALSE}
limits <- aes(ymax = mean + (1.645*se), ymin=mean - (1.645*se)) # 90% Confidence intervals

# limits <- aes(ymax = mean + (1.96*se), ymin=mean - (1.96*se)) # 95% Confidence intervals

dodge <- position_dodge(width=0.9)
j_dodge <- position_jitterdodge(dodge.width=.9, jitter.width = 1.5)


# Bar Graph
# Help from: http://www.sthda.com/english/articles/24-ggpubr-publication-ready-plots/76-add-p-values-and-significance-levels-to-ggplots/
p <- ggbarplot(music, x='Name', y='R_change', fill='Name', palette='jco',add = c('mean_se'), alpha=.6) + 
        geom_jitter(data = music, position=j_dodge,show.legend=FALSE,
               aes(x = as.numeric(Name), y = R_change, fill=Name, color=Name)) +
        stat_compare_means(method = 'anova', label.y=105) +
        ylab('Emotion Rating') +
        xlab('Music') +
        labs(fill = "Music") +
        theme(legend.key = element_rect(colour = NA))
p
ggsave(p, filename = paste0(plots_dir, "MusicRating.png"),  bg = "transparent")


# Direct Comparison as opposed to the rating value
p <- ggbarplot(music, x='Name', y='Votes', fill='Name', palette='jco',add = c('mean_se'), alpha=.6) + 
        # geom_jitter(data = music, position=j_dodge,show.legend=FALSE,
        #        aes(x = as.numeric(Name), y = Votes, fill=Name, color=Name)) +
        stat_compare_means(label.y=1.01) +
        ylab('Votes') +
        xlab('Music') +
        labs(fill = "Music") +
        theme(legend.key = element_rect(colour = NA))
p
ggsave(p, filename = paste0(plots_dir, "MusicVotes.png"),  bg = "transparent")


```
As you can see there is no clear music that was deemed as the most scary. This leaves a few options. We could:

+ Just select the one with the biggest change
+ We could use faces in between trials

### Videos Results
The video results follow the same structure as the music section. 
```{r manipulation_check, warning=FALSE, message=FALSE}
## Videos
p <- ggbarplot(video, x='Name', y='Rating', fill='Name', palette='jco',add = c('mean_se'), alpha=.6) + 
        geom_jitter(data = video, position=j_dodge,show.legend=FALSE,
               aes(x = as.numeric(Name), y = Rating, fill=Name, color=Name)) +
        stat_compare_means(method = 'anova', label.y=105) +
        ylab('Emotion Rating') +
        xlab('Video') +
        labs(fill = "Video") +
        theme(legend.key = element_rect(colour = NA))
p 
ggsave(p, filename = paste0(plots_dir, "VideoRating.png"),  bg = "transparent")
        


# Help from: http://www.sthda.com/english/articles/24-ggpubr-publication-ready-plots/76-add-p-values-and-significance-levels-to-ggplots/
p <- ggbarplot(video, x='Name', y='Votes', fill='Name', palette='jco',add = c('mean_se'), alpha=.6) + 
        # geom_jitter(data = video, position=j_dodge,show.legend=FALSE,
        #        aes(x = as.numeric(Name), y = Votes, fill=Name, color=Name)) +
        stat_compare_means(label.y=1.01) +
        ylab('Votes') +
        xlab('Video') +
        labs(fill = "Video") +
        theme(legend.key = element_rect(colour = NA))
p 
ggsave(p, filename = paste0(plots_dir, "VideoVotes.png"),  bg = "transparent")
```

For the Videos, there does seem to be a clear obvious loser, but no clear obvious winning (based on inferential statisitcs). However, the hear video had the most votes and it had the biggest change in emotion rating, albeit by only a small margin. 

## Emotion Ratings Over time
```{r time_plot, warning=FALSE, message=FALSE}
time_data <- data.frame(Rating=c(qual_data$Pre.Emotions_3,long_format$Rating),
                        Time=factor(c(rep(0,nrow(M_order)),long_format$Overall_Order), 
                                    labels = c('Pre','M1','M2','V1','V2')))
p <- ggbarplot(time_data, x='Time', y='Rating', fill='Time', palette='jco',add = c('mean_se'), alpha=.6) + 
        geom_jitter(data = time_data, position=j_dodge,show.legend=FALSE,
               aes(x = as.numeric(Time), y = Rating, fill=Time, color=Time)) +
        stat_compare_means(label.y=105, method = 'anova') +
        stat_compare_means(label = "p.signif", method = "t.test", paired=TRUE,
                     ref.group = "Pre") +
        ylab('Rating') +
        xlab('Time') +
        labs(fill = "Time") +
        theme(legend.key = element_rect(colour = NA))
p 
ggsave(p, filename = paste0(plots_dir, "TimeRating.png"),  bg = "transparent")

time_vote <- data.frame(Vote=c(M_compare_data,V_compare_data),
                        Time=rep(rep(c('First','Second'),each=nrow(M_order)),2))
p <- ggbarplot(time_vote, x='Time', y='Vote', fill='Time', palette='jco',add = c('mean_se'), alpha=.6) + 
        # stat_compare_means(label.y=1.05) +
        # stat_compare_means(label = "p.signif", method = "t.test", paired=TRUE,
        #              ref.group = ".all.") +
        ylab('Rating') +
        xlab('Time') +
        labs(fill = "Time") +
        theme(legend.key = element_rect(colour = NA))
p 
ggsave(p, filename = paste0(plots_dir, "TimeVote.png"),  bg = "transparent")
```
I think this is important to note that across all music types and video types, the stimuli did affect the individuals fear rating significantly. I included the votes to get a sense of whether, in general, people found the second stimuli more fearful, suggesting an accumulation of fear. I found nothing. Below I looked a the means specifically and the variance are just so large, it would wash out any potential effects, but in all cases the second one was both rated with slightly higher ratings and voted more often. However, these effects (if real) are extremely small. I am only presenting them since this is just a pilot and it seemed interesting to explore. 

```{r time_table, results='axis'}
t_stat <- describeBy(time_data$Rating, group = time_data$Time, mat=TRUE); row.names(t_stat) <- NULL
kable(t_stat[,c(2,4:6)], col.names = c('Time', 'N','Mean', 'SD'), caption = 'Music Frequency Table')
```


## Conclusion
I think it pretty clear that we should be using that **hear** video. As for the music, I would like to discuss the potential options together (just choosing one or going with the fearful faces). One caveat is that I only looked at their fear ratings, but other emotions may have bee affected also, although I doubt it. 

I am also open to other ways of analyzing the data.


